home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / t_os / ashula / trans.bas < prev    next >
BASIC Source File  |  1991-10-18  |  23KB  |  440 lines
  1. 5 'save "h:\trans.bas"
  2. 10 'ASHULA SCENARIO TEXT to OBJECT Transrator program
  3. 20 ' for ASHULA version 0.87
  4. 30 '                        All Programmed By -OcToh-
  5. 40 DEFINT A-Z:ENV$=".\trans.env"
  6. 50 DEF FNN$(NUM)=RIGHT$(STR$(NUM),LEN(STR$(NUM))-1):DEF FNB!(M$)=CVL(RIGHT$(M$,1)+MID$(M$,3,1)+MID$(M$,2,1)+LEFT$(M$,1)):DEF FNO$(A%)=RIGHT$(MKI$(A%),1)+LEFT$(MKI$(A%),1):DEF FNO(A$)=ASC(LEFT$(A$,1))+ASC(RIGHT$(A$,1))*256
  7. 60 CONSOLE 3,20:CLS
  8. 100 ON ERROR GOTO 190:OPEN "I",#1,ENV$:ON ERROR GOTO 0:DUM=ASC(INPUT$(1,1)):I$=INPUT$(DUM,1):DUM=ASC(INPUT$(1,1)):O$=INPUT$(DUM,1):CLOSE:LOCATE 0,0:PRINT I$+" --> "+O$;
  9. 110 WAIT 200:IF INKEY$="" THEN 200
  10. 120 CLS 1:LINE INPUT "シナリオソースファイル名:",I$:PRINT :LINE INPUT "シナリオオブジェクトファイル名:",O$
  11. 150 ON ERROR GOTO 160:OPEN "O",#1,ENV$:PRINT #1,CHR$(LEN(I$))+I$+CHR$(LEN(O$))+O$;:CLOSE:ON ERROR GOTO 0:GOTO 200
  12. 160 IF ERR=64 THEN KILL ENV$:RESUME
  13. 170 CLS 1:PRINT USING "環境ファイルを出力中に異常が発生しました. erl=##### err=###";ERL;ERR;:GOTO 65030
  14. 190 RESUME 120
  15. 200 WHILE INKEY$<>"":WEND:OPEN "I",#1,I$:ON ERROR GOTO *WERR:OPEN "O",#2,O$:ON ERROR GOTO 0:CLS
  16. 500 *MAIN
  17. 510 IF EOF(1) THEN LOCATE 0,24:PRINT "終了しました｡";:SYSTEM ELSE LINE INPUT #1,LO$:L$=LO$
  18. 520 IF LEN(L$)=0 THEN 510
  19. 530 FOR L=1 TO LEN(L$):A$=MID$(L$,L,1):IF ASC(A$)>96 AND ASC(A$)<123 THEN MID$(L$,L,1)=CHR$(ASC(A$)-32)
  20. 540 NEXT:L=1:GOSUB *DELSPACE:CLS 2:LOCATE 0,0:PRINT L$;:LOCATE 0,22:PRINT LO$
  21. 560 ON A-64 GOTO *A,*B,*C,*D,*E,*F,*G,*H,*I,*J,*K,*L,*M,*N,*O,*P,*Q,*R,*S,*T,*U,*V,*W,*X,*Y,*Z
  22. 600 *OTHER
  23. 610 GOTO *UNKNOWNERROR
  24. 700 *CMDSEARCH
  25. 710 READ N:CMDL=0:CMD=0:CMDF=0
  26. 720 FOR A=0 TO N-1:READ DUM$,DUM1$:DUM=VAL("&H"+DUM1$):IF DUM$=MID$(L$,L,LEN(DUM$)) THEN CMDL=LEN(DUM$):CMD=DUM:CMDF=A+1
  27. 730 NEXT
  28. 740 IF CMD=0 THEN *UNKNOWNERROR
  29. 750 L=L+CMDL
  30. 760 RETURN
  31. 800 *NUMSEARCH
  32. 810 N$="":WHILE (" "<>MID$(L$,L,1) AND L<=LEN(L$)):N$=N$+MID$(L$,L,1):L=L+1:WEND:N=VAL(N$):RETURN
  33. 850 *LAYERSEARCH
  34. 860 IF INSTR("01",MID$(L$,L,1))=0 THEN *LAYERERROR ELSE N$=MID$(L$,L,1):N=VAL(N$):L=L+1:RETURN
  35. 900 *DELSPACE:WHILE (" "=MID$(L$,L,1) AND L<=LEN(L$)):L=L+1:WEND:A$=MID$(L$,L,1):A=ASC(A$):RETURN
  36. 950 *REMOVESPACE:M$=RIGHT$(L$,LEN(L$)-L+1):L$="":FOR A=1 TO LEN(M$):IF " "<>MID$(M$,A,1) THEN L$=L$+MID$(M$,A,1)
  37. 960 NEXT:L=1:RETURN
  38. 1000 *A
  39. 1010 GOTO *UNKNOWNERROR
  40. 2000 *B
  41. 2010 RESTORE 2900:GOSUB *CMDSEARCH
  42. 2020 ON CMDF GOTO *BKGND,*BEGIN,*BOX,*BUTTON,*BUTTON
  43. 2100 *BKGND
  44. 2110 GOSUB *DELSPACE
  45. 2120 B=A:IF A=64 THEN CMD=CMD+1:L=L+1:GOSUB *DELSPACE
  46. 2130 IF B<>64 THEN IF INSTR("1234567890",A$)=0 THEN ALM$="@が指定されていないのにファイル名と思われるパラメータが指定されています。コマンドを置き換えますか? (取消/実行)":GOSUB *ALART:IF YN=0 THEN CMD=CMD+1:B=64
  47. 2140 PRINT #2,CHR$(CMD);:IF B=64 THEN GOSUB *PUTFILE:GOTO 2160
  48. 2150 GOSUB *NUMSEARCH:PRINT #2,CHR$(N);
  49. 2160 GOTO *MAIN
  50. 2200 *BEGIN
  51. 2210 PRINT #2,CHR$(CMD);:GOTO *MAIN
  52. 2250 *BOX
  53. 2260 GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(CMD,N);:FOR BBB=0 TO 3:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,FNO$(N);:NEXT:GOTO *MAIN
  54. 2300 *BUTTON
  55. 2310 GOSUB *DELSPACE:IF "GET"=MID$(L$,L,3) THEN L=L+3:CMD=&H2A:GOTO 2330
  56. 2320 IF "WAIT"=MID$(L$,L,4) THEN L=L+4:CMD=&H2B ELSE *UNKNOWNERROR
  57. 2330 GOSUB *DELSPACE
  58. 2340 IF "END"=MID$(L$,L,3) THEN L=L+3:EF=0:GOSUB *PUT_BTNCMD:GOTO *MAIN
  59. 2350 IF "BREAK"=MID$(L$,L,5) THEN L=L+5:EF=1:GOSUB *PUT_BTNCMD:GOSUB *BREAK_ADD:GOTO *MAIN
  60. 2360 IF "PAUSE"=MID$(L$,L,5) THEN L=L+5:EF=2:GOSUB *PUT_BTNCMD:GOTO *MAIN
  61. 2480 GOTO *UNKNOWNERROR
  62. 2490 *PUT_BTNCMD:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(CMD,(N+EF*2));:RETURN
  63. 2900 DATA 5
  64. 2910 DATA "BACKGROUND","37", "BEGIN","26", "BOX","35", "BTN","2A" ,"BUTTON","2A"
  65. 3000 *C
  66. 3010 RESTORE 3900:GOSUB *CMDSEARCH
  67. 3020 ON CMDF GOTO *CAST,*CLEAR,*CLS,*COLOR,*CONTINUE,*CONTINUE,*CREDIT
  68. 3100 *CAST
  69. 3110 GOSUB *DELSPACE:IF "LOAD"<>MID$(L$,L,4) THEN *UNKNOWNERROR
  70. 3120 PRINT #2,CHR$(CMD);:L=L+4:GOSUB *DELSPACE:GOSUB *PUTFILE:GOTO *MAIN
  71. 3200 *CLEAR
  72. 3210 GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(CMD,N);:GOTO *MAIN
  73. 3300 *CLS
  74. 3310 GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:GOTO *MAIN
  75. 3400 *COLOR
  76. 3410 GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(N);:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,FNO$(N);:GOTO *MAIN
  77. 3500 *CONTINUE
  78. 3510 GOSUB *DELSPACE:IF "STRING"<>MID$(L$,L,6) THEN *UNKNOWNERROR
  79. 3520 L=L+6:GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:GOSUB *DELSPACE:GOSUB *PUTSTRING:GOTO *MAIN
  80. 3600 *CREDIT
  81. 3610 GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(CMD,N);:GOSUB *DELSPACE:GOSUB *PUTFILE:GOTO *MAIN
  82. 3900 DATA 7
  83. 3910 DATA "CAST","2E", "CLEAR","2F", "CLS","4B", "COLOR","4D", "CONTINUE","41","CONT","41", "CREDIT","42"
  84. 4000 *D
  85. 4010 RESTORE 4900:GOSUB *CMDSEARCH
  86. 4020 ON CMDF GOTO *DISPLAY
  87. 4100 *DISPLAY
  88. 4110 GOSUB *DELSPACE:IF A$="S" THEN 4200
  89. 4120 GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:GOSUB *DELSPACE
  90. 4130 IF "NONE"=MID$(L$,L,4) THEN A=0:GOTO 4170
  91. 4140 IF "LAYER0"=MID$(L$,L,6) THEN A=1:GOTO 4170
  92. 4150 IF "LAYER1"=MID$(L$,L,6) THEN A=2:GOTO 4170
  93. 4160 IF "BOTH"=MID$(L$,L,4) THEN A=3
  94. 4170 PRINT #2,CHR$(A);:GOTO *MAIN
  95. 4200 IF "SET"<>MID$(L$,L,3) THEN *UNKNOWNERROR
  96. 4210 L=L+3:GOSUB *DELSPACE:GOSUB *LAYERSEARCH
  97. 4220 PRINT #2,CHR$(CMD,(N OR &H80));:GOSUB *DELSPACE
  98. 4230 IF "ORIGIN"=MID$(L$,L,6) THEN A=0:L=L+6:GOTO 4270
  99. 4240 IF "MOVE"=MID$(L$,L,4) THEN A=1:L=L+4:GOTO 4270
  100. 4250 IF "ZOOM"=MID$(L$,L,4) THEN A=2:L=L+4:GOTO 4270
  101. 4260 IF "SCALE"=MID$(L$,L,5) THEN L=L+5:A=3
  102. 4270 PRINT #2,CHR$(A);:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PA=N:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,FNO$(PA)+FNO$(N);:GOTO *MAIN
  103. 4900 DATA 1
  104. 4910 DATA "DISPLAY","49"
  105. 5000 *E
  106. 5010 RESTORE 5900:GOSUB *CMDSEARCH
  107. 5020 ON CMDF GOTO *EFFECT,*EGB,*END
  108. 5100 *EFFECT
  109. 5110 GOSUB *EFFECTIN:PRINT #2,CHR$(CMD,SP,EF);:GOTO *MAIN
  110. 5120 *EFFECTIN
  111. 5130 GOSUB *DELSPACE:GOSUB *REMOVESPACE:SP=2:EF=&H21
  112. 5140 IF "VERYFAST"=MID$(L$,L,8) THEN L=L+8:SP=0:GOTO 5190
  113. 5150 IF "FAST"=MID$(L$,L,4) THEN L=L+4:SP=1:GOTO 5190
  114. 5160 IF "NOMAL"=MID$(L$,L,5) THEN L=L+5:SP=2:GOTO 5190
  115. 5170 IF "SLOW"=MID$(L$,L,4) THEN L=L+4:SP=3:GOTO 5190
  116. 5180 IF "VERYSLOW"=MID$(L$,L,8) THEN L=L+8:SP=4:GOTO 5190
  117. 5190 IF "DISABLE"=MID$(L$,L,8) THEN L=L+7:EF=&H21:GOTO *PUTEFF
  118. 5200 IF "WIPE"=MID$(L$,L,4) THEN L=L+4:EF=&H30:GOTO *DIRCHK
  119. 5210 IF "SCROLL"=MID$(L$,L,6) THEN L=L+6:EF=&H34:GOTO *DIRCHK
  120. 5220 IF "HORIZONTAL"=MID$(L$,L,10) THEN L=L+10:EF=&H38:GOTO *OPENCHK
  121. 5230 IF "VERTICAL"=MID$(L$,L,8) THEN L=L+8:EF=&H3A:GOTO *OPENCHK
  122. 5240 IF "ZOOM"=MID$(L$,L,4) THEN L=L+4:EF=&H3C:GOTO *OPENCHK
  123. 5250 IF "DISSOLVE"=MID$(L$,L,8) THEN L=L+8:EF=&H3E:GOTO *PUTEFF
  124. 5260 IF "BLIND"=MID$(L$,L,5) THEN L=L+5:EF=&H3F:GOTO *PUTEFF
  125. 5270 IF "LINEDISSOLVE"=MID$(L$,L,12) THEN L=L+12:EF=&H3F:GOTO *PUTEFF
  126. 5280 IF "SHIFT"=MID$(L$,L,5) THEN L=L+5:EF=&H40:GOTO *DIRCHK
  127. 5290 IF "PALETTE"=MID$(L$,L,7) THEN L=L+7:EF=&H44:GOTO *PUTEFF
  128. 5300 IF "COMPRESS"=MID$(L$,L,8) THEN L=L+8:EF=&H45:GOTO *DIRCHK
  129. 5310 GOTO *PUTEFF
  130. 5320 *DIRCHK
  131. 5330 IF "DOWN"=MID$(L$,L,4) THEN *PUTEFF
  132. 5340 IF "UP"=MID$(L$,L,2) THEN EF=EF+1:GOTO *PUTEFF
  133. 5350 IF "RIGHT"=MID$(L$,L,5) THEN EF=EF+2:GOTO *PUTEFF
  134. 5360 IF "LEFT"=MID$(L$,L,4) THEN EF=EF+3:GOTO *PUTEFF
  135. 5370 GOTO *UNKNOWNERROR
  136. 5380 *OPENCHK
  137. 5390 IF "CLOSE"=MID$(L$,L,5) THEN *PUTEFF
  138. 5400 IF "OPEN"=MID$(L$,L,4) THEN EF=EF+1:GOTO *PUTEFF
  139. 5410 GOTO *UNKNOWNERROR
  140. 5420 *PUTEFF
  141. 5430 SP=SP OR &H80:RETURN
  142. 5500 *EGB
  143. 5510 GOTO *NOTSUPPORTERROR
  144. 5800 *END
  145. 5810 PRINT #2,CHR$(CMD);:GOTO *MAIN
  146. 5900 DATA 3
  147. 5910 DATA "EFFECT","3C", "EGB","5F", "END","21"
  148. 6000 *F
  149. 6010 RESTORE 6900:GOSUB *CMDSEARCH
  150. 6020 ON CMDF GOTO *FADEIN,*FADEOUT,*FOR,*FUNCTION
  151. 6100 *FADEIN
  152. 6110 GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(CMD,N);:GOTO *MAIN
  153. 6200 *FADEOUT
  154. 6210 GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(CMD,N);:GOTO *MAIN
  155. 6300 *FOR
  156. 6310 GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(CMD,N);:GOTO *MAIN
  157. 6400 *FUNCTION
  158. 6410 GOSUB *DELSPACE
  159. 6420 IF "PSET"=MID$(L$,L,4) THEN EF=0:L=L+4:GOTO 6540
  160. 6430 IF "PRESET"=MID$(L$,L,6) THEN EF=1:L=L+6:GOTO 6540
  161. 6440 IF "OR"=MID$(L$,L,2) THEN EF=2:L=L+2:GOTO 6540
  162. 6450 IF "AND"=MID$(L$,L,3) THEN EF=3:L=L+3:GOTO 6540
  163. 6460 IF "XOR"=MID$(L$,L,3) THEN EF=4:L=L+3:GOTO 6540
  164. 6470 IF "NOT"=MID$(L$,L,3) THEN EF=5:L=L+3:GOTO 6540
  165. 6480 IF "MATTE"=MID$(L$,L,5) THEN EF=6:L=L+5:GOTO 6540
  166. 6490 IF "OPAQUE"=MID$(L$,L,6) THEN EF=9:L=L+6:GOTO 6540
  167. 6500 IF "IMPSET"=MID$(L$,L,6) THEN EF=10:L=L+6:GOTO 6540
  168. 6510 IF "IMPRESET"=MID$(L$,L,8) THEN EF=11:L=L+8:GOTO 6540
  169. 6520 IF "IMPNOT"=MID$(L$,L,6) THEN EF=12:L=L+6:GOTO 6540
  170. 6530 GOTO *PARAERROR
  171. 6540 PRINT #2,CHR$(CMD,EF);:GOTO *MAIN
  172. 6900 DATA 4
  173. 6910 DATA "FADEIN","3A", "FADEOUT","3B", "FOR","28", "FUNCTION","33"
  174. 7000 *G
  175. 7010 RESTORE 7900:GOSUB *CMDSEARCH
  176. 7020 ON CMDF GOTO *GET
  177. 7100 *GET
  178. 7110 GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(CMD,N);:GOTO *MAIN
  179. 7900 DATA 1
  180. 7910 DATA "GET","32"
  181. 8000 *H
  182. 8010 GOTO *UNKNOWNERROR
  183. 9000 *I
  184. 9010 GOTO *UNKNOWNERROR
  185. 10000 *J
  186. 10010 GOTO *UNKNOWNERROR
  187. 11000 *K
  188. 11010 GOTO *UNKNOWNERROR
  189. 12000 *L
  190. 12010 RESTORE 12900:GOSUB *CMDSEARCH
  191. 12020 ON CMDF GOTO *LAYER,*LINK
  192. 12100 *LAYER
  193. 12110 GOSUB *DELSPACE:IF "SET"<>MID$(L$,L,3) THEN *UNKNOWNERROR
  194. 12120 L=L+3:GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:GOTO *MAIN
  195. 12200 *LINK
  196. 12210 GOSUB *DELSPACE:PRINT #2,CHR$(CMD);:GOSUB *PUTFILE:GOTO *MAIN
  197. 12900 DATA 2
  198. 12910 DATA "LAYER","56", "LINK","23"
  199. 13000 *M
  200. 13010 RESTORE 13900:GOSUB *CMDSEARCH
  201. 13020 ON CMDF GOTO *MOUSE,*MUSIC
  202. 13100 *MOUSE
  203. 13110 GOSUB *DELSPACE
  204. 13120 IF "ON"=MID$(L$,L,2) THEN EF=&H80:GOTO 13190
  205. 13130 IF "OFF"=MID$(L$,L,3) THEN EF=&H81:GOTO 13190
  206. 13190 PRINT #2,CHR$(CMD,EF);:GOTO *MAIN
  207. 13500 *MUSIC
  208. 13510 GOSUB *DELSPACE
  209. 13520 IF "PAUSE"=MID$(L$,L,5) THEN EF=&H70:GOTO 13590
  210. 13530 IF "STOP"=MID$(L$,L,4) THEN EF=&H71:GOTO 13590
  211. 13540 IF "RESTART"=MID$(L$,L,7) THEN EF=&H72:GOTO 13590
  212. 13550 IF "LOOP"=MID$(L$,L,4) THEN L=L+4:GOSUB *DELSPACE:IF "OFF"=MID$(L$,L,3):EF=&H78 ELSE IF "ON"=MID$(L$,L,2):EF=&H79:GOTO 13590
  213. 13580 GOTO *UNKNOWNERROR
  214. 13590 PRINT #2,CHR$(CMD,EF);:GOTO *MAIN
  215. 13900 DATA 2
  216. 13910 DATA "MOUSE","2C", "MUSIC","5A"
  217. 14000 *N
  218. 14010 RESTORE 14900:GOSUB *CMDSEARCH
  219. 14020 ON CMDF GOTO *NEXT
  220. 14100 *NEXT
  221. 14110 PRINT #2,CHR$(CMD);:GOTO *MAIN
  222. 14900 DATA 1
  223. 14910 DATA "NEXT","29"
  224. 15000 *O
  225. 15010 RESTORE 15900:GOSUB *CMDSEARCH
  226. 15020 ON CMDF GOTO *OBJECT
  227. 15100 *OBJECT
  228. 15110 GOSUB *DELSPACE
  229. 15120 B=A:IF A=64 THEN CMD=CMD+1:L=L+1:GOSUB *DELSPACE
  230. 15130 IF B<>64 THEN IF INSTR("1234567890",A$)=0 THEN ALM$="@が指定されていないのにファイル名と思われるパラメータが指定されています。コマンドを置き換えますか? (取消/実行)":GOSUB *ALART:IF YN=0 THEN CMD=CMD+1:B=64
  231. 15140 PRINT #2,CHR$(CMD);:IF B=64 THEN GOSUB *PUTFILE:GOTO 15160
  232. 15150 GOSUB *NUMSEARCH:PRINT #2,CHR$(N);
  233. 15160 GOTO *MAIN
  234. 15900 DATA 1
  235. 15910 DATA "OBJECT","54"
  236. 16000 *P
  237. 16010 RESTORE 16900:GOSUB *CMDSEARCH
  238. 16020 ON CMDF GOTO *PALETTE,*PAN,*PLAY,*POINT,*PUT
  239. 16100 *PALETTE
  240. 16110 GOSUB *DELSPACE:IF "@"=MID$(L$,L,1) THEN L=L+1:GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,(N OR &H80));:GOTO *MAIN
  241. 16120 GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:FOR BBB=0 TO 3:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(N);:NEXT:GOTO *MAIN
  242. 16200 *PAN
  243. 16210 GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PA=N:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(CMD,((PA*16) OR N));:FOR BBB=0 TO 1:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,FNO$(N);:NEXT:GOTO *MAIN
  244. 16300 *PLAY
  245. 16320 GOSUB *DELSPACE:B=A:IF A=64 THEN CMD=CMD+1:L=L+1:GOSUB *DELSPACE
  246. 16330 IF B<>64 THEN IF INSTR("1234567890",A$)=0 THEN ALM$="@が指定されていないのにファイル名と思われるパラメータが指定されています。コマンドを置き換えますか? (取消/実行)":GOSUB *ALART:IF YN=0 THEN CMD=CMD+1:B=64
  247. 16340 PRINT #2,CHR$(CMD);:IF B=64 THEN GOSUB *PUTFILE:GOTO 16360
  248. 16350 GOSUB *NUMSEARCH:PRINT #2,CHR$(N);
  249. 16360 GOTO *MAIN
  250. 16400 *POINT
  251. 16410 GOSUB *DELSPACE:IF "SET"<>MID$(L$,L,3) THEN *UNKNOWNERROR
  252. 16420 L=L+3:GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:FOR BBB=0 TO 1:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,FNO$(N);:NEXT:GOTO *MAIN
  253. 16500 *PUT
  254. 16510 GOSUB *DELSPACE:IF A=64 THEN CMD=CMD+1:L=L+1:GOSUB *DELSPACE
  255. 16520 BBB=INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ",A$):IF BBB=0 THEN *PARAERROR
  256. 16530 PRINT #2,CHR$(CMD,BBB-1);:L=L+1
  257. 16540 GOSUB *DELSPACE:IF A$<>"-" THEN *SYNTAXERROR
  258. 16550 L=L+1:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(N);:GOTO *MAIN
  259. 16900 DATA 5
  260. 16910 DATA "PALETTE","39", "PAN","36", "PLAY","5C", "POINT","53", "PUT","30"
  261. 17000 *Q
  262. 17010 GOTO *UNKNOWNERROR
  263. 18000 *R
  264. 18010 RESTORE 18900:GOSUB *CMDSEARCH
  265. 18020 ON CMDF GOTO *ROLL
  266. 18100 *ROLL
  267. 18110 GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PA=N:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(CMD,(PA*16+N));:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,FNO$(N);
  268. 18120 FOR BBB=0 TO 1:GOSUB *DELSPACE:GOSUB *NUMSEARCH:IF N<127 THEN PRINT #2,CHR$(N OR &H80); ELSE PRINT #2,MKI$(N);
  269. 18130 NEXT:GOTO *MAIN
  270. 18900 DATA 1
  271. 18910 DATA "ROLL","4C"
  272. 19000 *S
  273. 19010 RESTORE 19900:GOSUB *CMDSEARCH
  274. 19020 ON CMDF GOTO *SCREEN,*SECURE,*SET,*SOUND,*STRING,*SLIDE
  275. 19100 *SCREEN
  276. 19110 GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PA=N:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(CMD,PA,N);:GOTO *MAIN
  277. 19200 *SECURE
  278. 19210 GOSUB *DELSPACE:IF "BUFFER"<>MID$(L$,L,6) THEN *UNKNOWNERROR
  279. 19220 L=L+6:GOSUB *DELSPACE:GOSUB *NUMSEARCH:IF N=0 THEN *PARAERROR ELSE PRINT #2,CHR$(CMD,N);:GOTO *MAIN
  280. 19300 *SET
  281. 19310 GOSUB *DELSPACE:IF "PMGF"=MID$(L$,L,4) THEN L=L+4:EF=&H60:GOTO 19350
  282. 19320 IF "GRAPHIC"=MID$(L$,L,7) THEN L=L+7:EF=&H60:GOTO 19350
  283. 19330 IF "SOUND"=MID$(L$,L,5) THEN L=L+5:EF=&H61:GOTO 19350
  284. 19340 IF "MUSIC"=MID$(L$,L,5) THEN L=L+5:EF=&H62
  285. 19350 GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(CMD,EF,N);:GOSUB *DELSPACE::GOSUB *PUTFILE:GOTO *MAIN
  286. 19400 *SOUND
  287. 19410 GOSUB *DELSPACE
  288. 19420 B=A:IF A=64 THEN CMD=CMD+1:L=L+1:GOSUB *DELSPACE
  289. 19430 IF B<>64 THEN IF INSTR("1234567890",A$)=0 THEN ALM$="@が指定されていないのにファイル名と思われるパラメータが指定されています。コマンドを置き換えますか? (取消/実行)":GOSUB *ALART:IF YN=0 THEN CMD=CMD+1:B=64
  290. 19440 PRINT #2,CHR$(CMD);:IF B=64 THEN GOSUB *PUTFILE:GOTO 19460
  291. 19450 GOSUB *NUMSEARCH:PRINT #2,CHR$(N);
  292. 19460 GOSUB *DELSPACE:IF "PCM7"=MID$(L$,L,4) THEN EF=&H46:GOTO 19490
  293. 19470 IF "PCM8"=MID$(L$,L,4) THEN EF=&H47:GOTO 19490
  294. 19480 GOTO *PARAERROR
  295. 19490 PRINT #2,CHR$(EF);:GOTO *MAIN
  296. 19500 *STRING
  297. 19510 GOSUB *DELSPACE
  298. 19520 IF "CLEAR"=MID$(L$,L,5) THEN L=L+5:CMD=&H44:GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:GOTO *MAIN
  299. 19530 IF "COLOR"=MID$(L$,L,5) THEN L=L+5:CMD=&H42:GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,FNO$(N);:GOTO *MAIN
  300. 19540 IF "VIEW"<>MID$(L$,L,4) THEN 19650
  301. 19550 L=L+4:CMD=&H43:GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:FOR BBB=0 TO 3:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,FNO$(N);:NEXT:FOR BBB=0 TO 3:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(N);:NEXT
  302. 19560 GOSUB *DELSPACE:IF "SCROLL"=MID$(L$,L,6) THEN EF=&H30:PA=0:GOTO 19620
  303. 19570 IF "SMOOTH"=MID$(L$,L,6) THEN EF=&H31:PA=0:GOTO 19620
  304. 19580 IF "CLEAR"=MID$(L$,L,5) THEN L=L+5:EF=&H32:PA=1:GOTO 19620
  305. 19590 'IF "KEY"=MID$(L$,L,3) THEN L=L+3:EF=&H33:PA=1:GOTO 19620
  306. 19600 'IF "PAD"=MID$(L$,L,3) THEN L=L+3:EF=&H34:PA=1:GOTO 19620
  307. 19610 IF "MOUSE"=MID$(L$,L,5) THEN L=L+5:EF=&H35:PA=0
  308. 19620 PRINT #2,CHR$(EF);:IF PA=0 THEN *MAIN ELSE FOR A=1 TO PA:GOSUB *DELSPACE:PRINT #2,A$;:L=L+1:NEXT:GOTO *MAIN
  309. 19650 IF INSTR("01",A$)=0 THEN *PARAERROR
  310. 19660 GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:GOSUB *DELSPACE:GOSUB *PUTSTRING:GOTO *MAIN
  311. 19700 *SLIDE
  312. 19710 GOSUB *DELSPACE:IF "FM"=MID$(L$,L,2) THEN L=L+2:EF=0:GOTO 19740
  313. 19720 IF "PCM"=MID$(L$,L,3) THEN L=L+3:EF=&H40:GOTO 19740
  314. 19730 GOTO *PARAERROR
  315. 19740 IF INSTR("12345678",MID$(L$,L,1))=0 THEN *PARAERROR ELSE N=VAL(MID$(L$,L,1))-1:L=L+1
  316. 19750 PRINT #2,CHR$(CMD,EF+N);:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(N);:GOTO *MAIN
  317. 19900 DATA 6
  318. 19910 DATA "SCREEN","4A", "SECURE","24", "SET","22", "SOUND","3E", "STRING","40", "SLIDE","5E"
  319. 20000 *T
  320. 20010 GOTO *UNKNOWNERROR
  321. 21000 *U
  322. 21010 GOTO *UNKNOWNERROR
  323. 22000 *V
  324. 22010 RESTORE 22900:GOSUB *CMDSEARCH
  325. 22020 ON CMDF GOTO *VIEW,*VOLUME
  326. 22100 *VIEW
  327. 22110 GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT CHR$(CMD,N);
  328. 22120 FOR BBB=0 TO 3:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT FNO$(N);:NEXT:GOTO *MAIN
  329. 22200 *VOLUME
  330. 22210 GOSUB *DELSPACE:IF "PCM"=MID$(L$,L,3) THEN L=L+3:EF=&H40:GOTO 22240
  331. 22220 IF "FM"=MID$(L$,L,2) THEN L=L+2:EF=0:GOTO 22240
  332. 22230 IF "ALL"=MID$(L$,L,3) THEN L=L+3:GOTO 22270 ELSE *PARAERROR
  333. 22240 A$=MID$(L$,L,1):IF VAL(A$)=0 THEN *PARAERROR
  334. 22250 EF=EF+VAL(A$)-1:L=L+1
  335. 22260 GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(CMD,EF,N);:GOTO *MAIN
  336. 22270 IF "FM"=MID$(L$,L,2) THEN L=L+2:EF=96:GOTO 22260
  337. 22280 IF "PCMPLAY"=MID$(L$,L,7) THEN L=L+7:EF=98:GOTO 22260
  338. 22290 IF "PCM"=MID$(L$,L,3) THEN L=L+3:EF=97:GOTO 22260
  339. 22300 GOTO *UNKNOWNERROR
  340. 22900 DATA 2
  341. 22910 DATA "VIEW","57", "VOLUME","5B"
  342. 23000 *W
  343. 23010 RESTORE 23900:GOSUB *CMDSEARCH
  344. 23020 ON CMDF GOTO *WAIT,*WIPE,*WRITE
  345. 23100 *WAIT
  346. 23110 GOSUB *DELSPACE:IF "SOUND"=MID$(L$,L,5) THEN L=L+5:CMD=&H50:GOTO 23160
  347. 23120 IF "MUSIC"=MID$(L$,L,5) THEN L=L+5:CMD=&H52:GOTO 23160
  348. 23130 CMD=&H51:GOSUB *NUMSEARCH:IF N<127 THEN PRINT #2,CHR$(CMD,(N OR &H80)); ELSE PRINT #2,CHR$(CMD)+MKI$(N);
  349. 23150 GOTO *MAIN
  350. 23160 GOSUB *DELSPACE:IF "END"<>MID$(L$,L,3) THEN *UNKNOWNERROR
  351. 23170 L=L+3:PRINT #2,CHR$(CMD);:IF CMD=&H52 THEN *MAIN
  352. 23180 GOSUB *DELSPACE:IF "PCM"=MID$(L$,L,3) THEN L=L+3:EF=&H40:GOTO 23210
  353. 23190 IF "FM"=MID$(L$,L,2) THEN L=L+2:EF=0:GOTO 23210
  354. 23200 GOTO *PARAERROR
  355. 23210 A$=MID$(L$,L,1):IF VAL(A$)=0 THEN *PARAERROR
  356. 23220 EF=EF+VAL(A$)-1:PRINT #2,CHR$(EF);:GOTO *MAIN
  357. 23300 *WIPE
  358. 23310 GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PA=N:GOSUB *EFFECTIN
  359. 23320 IF EF<>&H21 THEN PRINT #2,CHR$(CMD,PA,SP,EF);:GOTO *MAIN ELSE PRINT #2,CHR$(&H4B,PA);:GOTO *MAIN
  360. 23400 *WRITE
  361. 23410 GOSUB *DELSPACE:IF INSTR("01",A$)<>0 THEN CMD=&H47:GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:GOSUB *DELSPACE:GOSUB *PUTSTRING:GOTO *MAIN
  362. 23420 IF "LOCATE"=MID$(L$,L,6) THEN L=L+6:CMD=&H45:GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:FOR BBB=0 TO 1:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,FNO$(N);:NEXT:GOTO *MAIN
  363. 23430 IF "OPTION"<>MID$(L$,L,6) THEN *PARAERROR
  364. 23440 L=L+6:CMD=&H46:GOSUB *DELSPACE:GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:GOSUB *DELSPACE
  365. 23450 WHILE "END"<>MID$(L$,L,3)
  366. 23460   IF "TRUE"=MID$(L$,L,4) THEN L=L+4:PRINT #2,CHR$(&H30);:GOTO *TLOOP
  367. 23470   IF "BOLD"=MID$(L$,L,4) THEN L=L+4:PRINT #2,CHR$(&H31);:GOTO *TLOOP
  368. 23480   IF "ITALIC"=MID$(L$,L,6) THEN L=L+6:PRINT #2,CHR$(&H32);:GOTO *TLOOP
  369. 23490   IF "SHADOW"=MID$(L$,L,6) THEN L=L+6:PRINT #2,CHR$(&H33);:GOTO *TLOOP
  370. 23500   IF "OUTLINE"=MID$(L$,L,7) THEN L=L+7:PRINT #2,CHR$(&H34);:GOTO *TLOOP
  371. 23510   IF "UNDERLINE"=MID$(L$,L,9) THEN L=L+9:PRINT #2,CHR$(&H35);:GOTO *TLOOP
  372. 23520   IF "OVERLINE"=MID$(L$,L,8) THEN L=L+8:PRINT #2,CHR$(&H36);:GOTO *TLOOP
  373. 23530   IF "STRIKETHROUGH"=MID$(L$,L,13) THEN L=L+13:PRINT #2,CHR$(&H37);:GOTO *TLOOP
  374. 23540   IF "ANK"=MID$(L$,L,3) THEN L=L+3:GOSUB *DELSPACE:IF "ZOOM"<>MID$(L$,L,4) THEN *PARAERROR ELSE L=L+4:PRINT #2,CHR$(&H58);:FOR BBB=0 TO 1:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(N);:NEXT:GOTO *TLOOP
  375. 23550   IF "KANJI"=MID$(L$,L,5) THEN L=L+5:GOSUB *DELSPACE:IF "ZOOM"<>MID$(L$,L,4) THEN *PARAERROR ELSE L=L+4:PRINT #2,CHR$(&H59);:FOR BBB=0 TO 1:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PRINT #2,CHR$(N);:NEXT:GOTO *TLOOP
  376. 23560   IF "TEXT"=MID$(L$,L,4) THEN L=L+4:GOSUB *DELSPACE
  377. 23570   IF "SPACE"=MID$(L$,L,5) THEN L=L+5:GOSUB *DELSPACE:IF "NOMAL"=MID$(L$,L,5) THEN PRINT #2,CHR$(&H51);:GOTO *TLOOP ELSE GOSUB *NUMSEARCH:PRINT #2,CHR$(&H50,N);:GOTO *TLOOP
  378. 23580   EF=&H40
  379. 23590   IF "DISPLAY"=MID$(L$,L,7) THEN L=L+7:EF=&H48:GOSUB *DELSPACE
  380. 23600   IF "DIRECTION"=MID$(L$,L,9) THEN L=L+9:GOTO 23630
  381. 23610   IF "DIR"=MID$(L$,L,3) THEN L=L+3:GOTO 23630
  382. 23620   GOTO *PARAERROR
  383. 23630   GOSUB *DELSPACE:IF "NOMAL"=MID$(L$,L,5) OR "RIGHT"=MID$(L$,L,5) THEN 23680
  384. 23640   IF "UP"=MID$(L$,L,2) THEN EF=EF+1:GOTO 23680
  385. 23650   IF "LEFT"=MID$(L$,L,4) THEN EF=EF+2:GOTO 23680
  386. 23660   IF "DOWN"=MID$(L$,L,4) THEN EF=EF+3:GOTO 23680
  387. 23670   GOTO *PARAERROR
  388. 23680   PRINT #2,CHR$(EF);:GOTO *TLOOP
  389. 23690   *TLOOP
  390. 23700 GOSUB *DELSPACE:WEND
  391. 23710 PRINT #2,CHR$(&HFD);:GOTO *MAIN
  392. 23900 DATA 3
  393. 23910 DATA "WAIT","50", "WIPE","3D", "WRITE","45"
  394. 24000 *X
  395. 24010 GOTO *UNKNOWNERROR
  396. 25000 *Y
  397. 25010 GOTO *UNKNOWNERROR
  398. 26000 *Z
  399. 26010 RESTORE 26900:GOSUB *CMDSEARCH
  400. 26020 ON CMDF GOTO *ZOOM
  401. 26100 *ZOOM
  402. 26110 GOSUB *DELSPACE
  403. 26120 IF INSTR("01",A$)<>0 THEN 26150
  404. 26130 IF "WITH"=MID$(L$,L,4) THEN L=L+4:GOSUB *DELSPACE:IF "VIEW"=MID$(L$,L,4) THEN L=L+4:CMD=&H59:GOSUB *DELSPACE:GOTO 26150
  405. 26140 GOTO *PARAERROR
  406. 26150 GOSUB *LAYERSEARCH:PRINT #2,CHR$(CMD,N);:GOSUB *DELSPACE:GOSUB *NUMSEARCH:PA=N-1:GOSUB *DELSPACE:GOSUB *NUMSEARCH:N=N-1:PRINT #2,CHR$((PA*16 OR N));:GOTO *MAIN
  407. 26900 DATA 1
  408. 26910 DATA "ZOOM","58"
  409. 50000 *PUTFILE
  410. 50010 M$="":PP$=MID$(L$,L,1):L=L+1
  411. 50020 WHILE PP$<>MID$(L$,L,1)
  412. 50030   M$=M$+MID$(L$,L,1):L=L+1
  413. 50040 WEND
  414. 50050 L=L+1:PRINT #2,CHR$(LEN(M$))+M$;:CLS 3:PRINT "PUT STRINGS :";M$;:RETURN
  415. 50100 *PUTSTRING
  416. 50110 M$="":PP$=MID$(L$,L,1):T=LEN(L$)
  417. 50120 WHILE PP$<>MID$(L$,T,1):T=T-1:WEND
  418. 50130 IF T=<L THEN M$=" ":GOTO 50150
  419. 50140 M$=MID$(LO$,(L+1),(T-L-1))
  420. 50150 L=T+1:CLS 3:PRINT "PUT STRINGS :";M$;:T=1
  421. 50160 WHILE INSTR(T,M$,"\n"):T=INSTR(T,M$,"\n"):PP$=LEFT$(M$,T-1)+RIGHT$(M$,LEN(M$)-T):M$=PP$:MID$(M$,T,1)=CHR$(13)
  422. 50490 WEND:PRINT #2,CHR$(LEN(M$))+M$;:RETURN
  423. 50500 *ALART:LOCATE 0,23:PRINT ALM$;:BEEP
  424. 50510 A$=INPUT$(1):IF A$<>CHR$(13) AND A$<>CHR$(24) THEN 50510
  425. 50520 IF A$=CHR$(13) THEN YN=0 ELSE YN=1
  426. 50530 RETURN
  427. 55000 *BREAK_ADD
  428. 55010 PRINT #2,FNO$(BOFS);:RETURN
  429. 60000 *UNKNOWNERROR:LOCATE 0,23:PRINT "理解不能なスクリプトが指定されました｡";:BEEP:CLOSE:GOTO 65030
  430. 60010 *PARAERROR:LOCATE 0,23:PRINT "スクリプトのパラメータが誤りです｡";:BEEP:CLOSE:GOTO 65030
  431. 60020 *SYNTAXERROR:LOCATE 0,23:PRINT "スクリプトに誤りがあります｡";:BEEP:CLOSE:GOTO 65030
  432. 60030 *LAYERERROR:LOCATE 0,23:PRINT "レイアの指定をすべき箇所に理解不能なパラメータがあります｡";:BEEP:CLOSE:GOTO 65030
  433. 60040 *NOTSUPPORTERROR:LOCATE 0,23:PRINT "現在このスクリプトは未サポートです｡";:BEEP:CLOSE:GOTO 65030
  434. 65000 *WERR:LOCATE 0,23:PRINT "指定されたシナリオオブジェクトは既に存在しています｡改訂しますか｡(取消/実行)";:BEEP
  435. 65010 A$=INPUT$(1):IF A$<>CHR$(13) AND A$<>CHR$(24) THEN 65010
  436. 65020 IF A$=CHR$(13) THEN KILL O$:RESUME
  437. 65030 LOCATE 0,24:PRINT "プログラムを終了します｡何かキーを押すか､マウスをクリックして下さい｡";
  438. 65040 MOUSE 0:A$="":WHILE A$="" AND MOUSE(2,0)=0 AND MOUSE(2,1)=0
  439. 65050 A$=INKEY$:WEND:MOUSE 5:END
  440.